home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / prog_bas / qbsvga.zip / QBSVGA.BAS < prev    next >
BASIC Source File  |  1996-04-22  |  26KB  |  862 lines
  1. '
  2. '  Subroutine BSCREEN emulates the function of QB's SCREEN statement.
  3. ' It uses subroutine FINDVESA to find a video mode supported by a VESA
  4. ' bios that corresponds to a "QB-type" mode specified by MODE.  The
  5. ' resolutions for each supported MODE integer are given below.
  6. '
  7. '   MODE = 14:   640 x  480 x 256
  8. '   MODE = 15:   800 x  600 x  16
  9. '   MODE = 16:   800 x  600 x 256
  10. '   MODE = 17:  1024 x  768 x  16
  11. '   MODE = 18:  1024 x  768 x 256
  12. '   MODE = 19:  1200 x 1024 x  16
  13. '   MODE = 20:  1200 x 1024 x 256
  14. '   MODE = 21:  1600 x 1200 x  16
  15. '   MODE = 22:  1600 x 1200 x 256
  16. '   MODE = 23:   132 x   25 x  16 (text)
  17. '   MODE = 24:   132 x   43 x  16 (text)
  18. '   MODE = 25:   132 x   50 x  16 (text)
  19. '
  20. ' These routines should not be used with modes not specified here.  Mode
  21. ' 0 is an allowable input; it corresponds to QB's SCREEN 0 and gets
  22. ' translated here to bios mode 3.  (Except for more colors, I'm not aware
  23. ' of any higher modes, anyway, and why would you want to use these
  24. ' routines with the lower modes?  QB's SCREEN statement will do that.)  If
  25. ' a mode with the desired resolution and colors cannot be found, a mode
  26. ' will still be selected if one can be found with the desired resolution
  27. ' and *more* colors than necessary.
  28. '
  29. '  The first four inputs are just as would be used with QB's SCREEN
  30. ' statement.  INREGS and OUTREGS are register variables defined as such
  31. ' in the MAIN routine.  (See REGTYPE.INC.  In the CALLs to these routines,
  32. ' you only need the "INREGS" and "OUTREGS"; you don't need the "AS
  33. ' REGISTERS" clauses there.)  Unlike the SCREEN statement, all parameters
  34. ' much be specified in the CALL.  If the input video mode is the one that
  35. ' is already in effect, BSCREEN can be used to simply change default
  36. ' colors or displayed/active pages.  (You might want to use subroutine
  37. ' BCOLOR for the former purpose.)  BSCREEN should be called before any of
  38. ' the other routines are called.
  39. '
  40. SUB BSCREEN(MODE,CL,APAGE,VPAGE,INREGS AS REGISTERS,OUTREGS AS REGISTERS)
  41. DIM CMODE AS INTEGER
  42. '
  43. '  Use variable aliases in case inputs were numeric literals in CALL
  44. ' statement.  Bios page numbers are zero-based.
  45. '
  46. C=CL : AP=APAGE-1 : VP=VPAGE-1
  47. '
  48. '  Get current video mode.  If it is same as one being set, no mode change
  49. ' is made.  The routine is just being used to change default colors
  50. ' (subroutine BCOLOR is simpler to use for that purpose) or pages.  (The
  51. ' value of CMODE may get changed after VESA-awareness is determined.)
  52. '
  53. INREGS.AX=&HF00
  54. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  55. CMODE=OUTREGS.AX AND &HFF
  56. '
  57. '  Set visible page.
  58. '
  59. INREGS.AX=VP+1280
  60. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  61. '
  62. '  Store active page and default color in global variables.
  63. '
  64. ACPAGE=AP
  65. IF C<=0 THEN C=7
  66. DEFLTC=C
  67. '
  68. '  Make correlation between "QB-type" modes and resolution of bios mode to
  69. ' be searched for.  (Set default mode data in case invalid mode was input.)
  70. '
  71. HR=800 : VR=600 : NC=16
  72. IF MODE=14 THEN HR=640 : VR=480
  73. IF MODE=15 OR MODE=16 THEN HR=800 : VR= 600
  74. IF MODE=17 OR MODE=18 THEN HR=1024 : VR=768
  75. IF MODE=19 OR MODE=20 THEN HR=1280 : VR=1024
  76. IF MODE=21 OR MODE=22 THEN HR=1600 : VR=1200
  77. IF MODE=23 THEN VR=25
  78. IF MODE=24 THEN VR=43
  79. IF MODE=25 THEN VR=50
  80. IF MODE=0 OR MODE=15 OR MODE=17 OR MODE=19 OR MODE=21 OR MODE>22 THEN NC=16
  81. IF MODE=14 OR MODE=16 OR MODE=18 OR MODE=20 OR MODE=22 THEN NC=256
  82. IF MODE=23 OR MODE=24 OR MODE=25 THEN HR=132
  83. '
  84. '  Define global resolution limits (zero-based) and viewport defaults.
  85. '
  86. HMAX=HR-1 : VMAX=VR-1 : VXL=0 : VYL=0 : VXR=HMAX : VYR=VMAX
  87. '
  88. '  Set VCOL to a negative number so other routines can tell that BVIEW
  89. ' wasn't called yet.
  90. '
  91. VCOL=-1
  92. IF MODE<>0 THEN
  93. '
  94. '  SCREEN is not being reset to text mode.  Find VESA mode with desired
  95. ' resolution.  If FINDVESA can't find a requisite VESA mode, whether
  96. ' because system isn't VESA-aware or other reasons, BMODE is returned as
  97. ' -1.  (If system is detected as VESA aware, an "error code" of 0 is
  98. ' defined via VESSUP variable.  If VESA cannot be detected, VESSUP is set
  99. ' to unity.)  Before using FINDVESA, however, look for overriding bios
  100. ' mode definition via DOS environment variable.  (This environment
  101. ' is SET with the syntax "MODE##=bios-mode", where ## is the two-digit
  102. ' QB-type mode integer that corresponds to bios-mode.)
  103. '
  104. QBMODE$="MODE"+LTRIM$(RTRIM$(STR$(MODE)))
  105. EMODE$=MID$(LTRIM$(ENVIRON$(QBMODE$)),1,80)
  106. BMODE=VAL("&H0"+EMODE$)
  107. IF BMODE=0 THEN
  108. '
  109. '  "MODE##" environment variable didn't exist for input QB-type mode.
  110. '
  111. CALL FINDVESA(BMODE,HR,VR,NC,INREGS,OUTREGS)
  112. '
  113. '  Except for text mode 3, there are no bios modes less than 4 that are
  114. ' of concern here.  (There aren't likely any below 13h of any importance.
  115. ' I'm just taking into account "wierd" video adapters, such as mine, which
  116. ' will do a hex mode B.)
  117. '
  118. IF BMODE>=4 THEN
  119. '
  120. '  VESA mode was found, hence, system is VESA-aware.  Redetermine current
  121. ' video mode.
  122. '
  123. INREGS.AX=&H4F03
  124. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  125. CMODE=OUTREGS.BX
  126. IF CMODE<>BMODE THEN
  127. '
  128. '  VESA mode was found and it is different from current mode; change video
  129. ' mode.
  130. '
  131. INREGS.AX=&H4F02
  132. INREGS.BX=BMODE
  133. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  134. END IF
  135. ELSE
  136. '
  137. '  VESA mode couldn't be found.  Assume "OEM SVGA" and ask user for
  138. ' hexadecimal mode integer that corresponds to desired video mode.  Set
  139. ' VESSUP according to value of input bios mode.  (Put screen in standard
  140. ' QB text mode so prompt can be seen in case it was already in some
  141. ' QB-unreadable graphics screen.)
  142. '
  143. INREGS.AX=3
  144. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  145. SCREEN 0,C,1,1
  146. RES$=LTRIM$(RTRIM$(STR$(HR)))+" x "+LTRIM$(RTRIM$(STR$(VR)))+" x "
  147. RES$=RES$+LTRIM$(RTRIM$(STR$(NC)))
  148. PRINT
  149. PRINT "  Couldn't find VESA mode giving resolution ";RES$;".  What"
  150. PRINT "hexadecimal bios mode integer gives you this resolution?  (Press ENTER"
  151. PRINT "to stop.)"
  152. LINE INPUT M$
  153. M$=RTRIM$(LTRIM$(M$))
  154. IF M$="" THEN STOP
  155. '
  156. '  Video mode is changed regardless of its present state when mode had to
  157. ' be prompted for.  (Even if the above text-mode change hadn't occurred,
  158. ' the prompt for the mode needs to be cleared.)
  159. '
  160. VESSUP=1
  161. INREGS.AX=VAL("&H"+M$)
  162. '
  163. '  Use VESA call to set video mode if it is 100h or above.  Otherwise,
  164. ' use standard bios call.
  165. '
  166. IF INREGS.AX>255 THEN
  167. VESSUP=0
  168. INREGS.BX=INREGS.AX
  169. INREGS.AX=&H4F02
  170. END IF
  171. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  172. END IF
  173. ELSE
  174. '
  175. '  "MODE##" environment variable exists for desired mode.  Set VESSUP
  176. ' according to value of bios mode.
  177. '
  178. VESSUP=1 : IF BMODE>255 THEN VESSUP=0
  179. '
  180. '  Re-acquire and test current video mode before changing it.
  181. '
  182. IF VESSUP=1 THEN
  183. INREGS.AX=&HF00
  184. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  185. CMODE=OUTREGS.AX AND &HFF
  186. INREGS.AX=BMODE
  187. ELSE
  188. INREGS.AX=&H4F03
  189. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  190. CMODE=OUTREGS.BX
  191. INREGS.AX=&H4F02
  192. INREGS.BX=BMODE
  193. END IF
  194. IF CMODE<>BMODE THEN CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  195. END IF
  196. ELSE
  197. '
  198. '  SCREEN 0 is being emulated.  Use what should be a standard text mode
  199. ' for any SVGA system.  (This mode is also set regardless of whether or
  200. ' not the video state is already there.)
  201. '
  202. INREGS.AX=3
  203. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  204. '
  205. '  Just to be safe, make sure QB knows what screen mode it's in.  (The
  206. ' above call to interrupt 10 could probably be skipped, but QB's SCREEN 0
  207. ' by itself doesn't necessarily leave you in the text mode you want when
  208. ' the screen isn't initially in a mode that QB recognizes.)
  209. '
  210. SCREEN 0,C,1,1
  211. END IF
  212. END SUB
  213. '
  214. '  This subroutine returns the VESA bios MODE integer (decimal) that has
  215. ' resolution HR x VR x NC, as input via the parameter list.  If no such
  216. ' mode can be found, MODE is returned as -1.  (If it finds a mode with
  217. ' the desired horizontal HR and vertical VR resolution but with more than
  218. ' NC colors, the mode is considered valid and is returned in MODE.  (It
  219. ' will first try to find a mode with NC colors.))  Also, it only looks for
  220. ' graphics modes.
  221. '
  222. '  To qualify as a valid, the mode must be supported by both hardware and
  223. ' bios.  (FINDVESA is usually called by BSCREEN.  There is not much reason
  224. ' to call it directly.)
  225. '
  226. SUB FINDVESA(MODE,HR,VR,NC,INREGS AS REGISTERS,OUTREGS AS REGISTERS)
  227. DIM VESA(1 TO 64) AS LONG,BYTE AS LONG,MD(1 TO 257) AS INTEGER,COLORS(1 TO 256)
  228. SM=VARSEG(VESA(1)) : OS=VARPTR(VESA(1))
  229. '
  230. '  Set VESSUP to unity in case VESA bios cannot be detected.
  231. '
  232. VESSUP=1
  233. '
  234. '  Confirm VESA support and get pointer to list of supported VESA modes.
  235. '
  236. INREGS.AX=&H4F00
  237. INREGS.ES=CINT(SM)
  238. INREGS.DI=CINT(OS)
  239. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  240. DEF SEG=SM
  241. T$=CHR$(PEEK(OS))+CHR$(PEEK(OS+1))+CHR$(PEEK(OS+2))+CHR$(PEEK(OS+3))
  242. IF T$<>"VESA" THEN GOTO NOSUP
  243. '
  244. '  VESA = VESA bios version number.
  245. '
  246. VESA=PEEK(OS+5)+PEEK(OS+4)/10
  247. PSM=PEEK(OS+16)+256*PEEK(OS+17) : POF=PEEK(OS+14)+256*PEEK(OS+15)
  248. '
  249. '  Look for video mode that supports desired resolution.
  250. '
  251. '  NMODES counts number of modes (possibly with different colors) with
  252. ' desired resolution.
  253. '
  254. NMODES=1
  255. NEWMODE:
  256. DEF SEG=PSM
  257. MD(NMODES)=PEEK(POF)+256*PEEK(POF+1) : POF=POF+2
  258. IF MD(NMODES)=-1 THEN GOTO NOSUP
  259. INREGS.AX=&H4F01
  260. INREGS.CX=MD(NMODES)
  261. INREGS.ES=CINT(SM)
  262. INREGS.DI=CINT(OS)
  263. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  264. DEF SEG=SM
  265. '
  266. '  First byte at segment SM stores "support information" about mode under
  267. ' analysis.
  268. '
  269. BYTE=CLNG(PEEK(OS)+256*PEEK(OS+1))
  270. B$=LTRIM$(RTRIM$(BIN$(BYTE)))
  271. '
  272. '  Bits 0 and 2 indicate support (or lack of it) in hardware and BIOS.
  273. '
  274. HARD$=MID$(B$,16,1)
  275. BIOS$=MID$(B$,14,1)
  276. IF HARD$="0" OR BIOS$="0" THEN GOTO NEWMODE
  277. '
  278. '  Bit 4 indicates graphics or text mode.
  279. '
  280. GMSW$=MID$(B$,12,1)
  281. '
  282. '  Bit 1 indicates the presence of extended information.  If no extended
  283. ' information is available for this mode, it cannot be determined that
  284. ' it supports the required HR x VR resolution.
  285. '
  286. EXTINF$=MID$(B$,15,1)
  287. IF EXTINF$="0" THEN GOTO NEWMODE
  288. '
  289. '  Character sizes are needed to correct stored resolution data for some
  290. ' VESA bioses.
  291. '
  292. HS=PEEK(OS+22) : VS=PEEK(OS+23)
  293. HRM=PEEK(OS+18)+256*PEEK(OS+19) : VRM=PEEK(OS+20)+256*PEEK(OS+21)
  294. IF VESA<1.2 THEN
  295. IF GMSW$="0" THEN HRM=HRM/HS : VRM=VRM/VS
  296. IF (MD(NMODES)>=0 AND MD(NMODES)<=6) OR MD(NMODES)=13 THEN VRM=VRM/2
  297. IF MD(NMODES)=14 OR MD(NMODES)=19 THEN VRM=VRM/2
  298. END IF
  299. IF HR<>HRM OR VR<>VRM THEN GOTO NEWMODE
  300. COLORS(NMODES)=2!^CSNG(PEEK(OS+25))
  301. '
  302. '  Get all modes with required resolution, regardless of color.  (Later
  303. ' on the one with NC colors, if it exists, will be chosen.  (But the
  304. ' possibility that the one with the right number of colors will be found
  305. ' first is taken into account.))
  306. '
  307. IF COLORS(NMODES)=NC THEN GOTO RETMODE
  308. IF NMODES<256 THEN NMODES=NMODES+1 : GOTO NEWMODE
  309. RETMODE:
  310. '
  311. '  Since VESA was detected, store corresponding error code.
  312. '
  313. VESSUP=0
  314. FOR I=1 TO NMODES
  315. K=I
  316. IF COLORS(I)=NC THEN MODE=MD(I) : GOTO QUIT
  317. NEXT I
  318. FOR I=1 TO NMODES
  319. K=I
  320. IF COLORS(I)>NC THEN MODE=MD(I) : GOTO QUIT
  321. NEXT I
  322. NOSUP:
  323. '
  324. '  Requisite VESA mode couldn't be found.  Return negative mode value as
  325. ' switch for calling routine to recognize that fact.
  326. '
  327. MODE=-1
  328. QUIT:
  329. DEF SEG
  330. END SUB
  331. '
  332. '  This is a "functionized" version of code extracted from a more general
  333. ' numeric base conversion program by Robert B. Relf, (C) 1984.  This just
  334. ' uses the part of Mr. Relf's code that converts decimal to binary.
  335. '
  336. FUNCTION BIN$(NUM AS LONG)
  337. DIM X AS INTEGER
  338. IF NUM<0 THEN NUM=NUM+65536&
  339. BIN1$=""
  340. FOR X=15 TO 0 STEP -1
  341. IF NUM>=(2^X) THEN
  342. BIN1$=BIN1$+"1"
  343. NUM=NUM-(2^X)
  344. ELSE
  345. BIN1$=BIN1$+"0"
  346. END IF
  347. NEXT X
  348. BIN1$=LEFT$(BIN1$,8)+RIGHT$(BIN1$,8)
  349. BIN$=BIN1$
  350. END FUNCTION
  351. '
  352. '  This subroutine is the analog of QB's intrinsic PSET statement.
  353. '
  354. SUB BPSET(XCOORD,YCOORD,CL,INREGS AS REGISTERS,OUTREGS AS REGISTERS)
  355. '
  356. '  Alias inputs in case they were input as numeric literals (which also
  357. ' serves to convert the viewport coordinates to screen coordinates).
  358. '
  359. C=CL : X=XCOORD+VXL : Y=YCOORD+VYL
  360. '
  361. '  Enforce viewport constraints.
  362. '
  363. IF X<VXL THEN X=VXL
  364. IF Y<VYL THEN Y=VYL
  365. IF X>VXR THEN X=VXR
  366. IF Y>VYR THEN Y=VYR
  367. INREGS.BX=CINT(ACPAGE)
  368. IF C<0 THEN C=DEFLTC
  369. INREGS.AX=3072+CINT(C)
  370. INREGS.CX=CINT(X)
  371. INREGS.DX=CINT(Y)
  372. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  373. END SUB
  374. '
  375. '  Subroutine BLINE emulates the functionality of QB's LINE statement.
  376. ' Except for LINE's "()" and "-" notation, BLINE's syntax is pretty much
  377. ' the same as LINE's.  The line style option is not supported here and
  378. ' the parameter specifying whether the drawn object is a line, box, or
  379. ' filled box ("L", "B", or "BF") must be in quotes in the CALL statement.
  380. ' Other than that, all parameters must be specified in the CALL.  As
  381. ' usual, INREGS and OUTREGS are register variables.
  382. '
  383. SUB BLINE(XLC,YLC,XRC,YRC,CL,BOX$,INREGS AS REGISTERS,OUTREGS AS REGISTERS)
  384. '
  385. '  Alias input variables in case they were input as numeric literals and
  386. ' then get page to draw on.
  387. '
  388. B$=UCASE$(BOX$) : C=CL : XL=XLC : YL=YLC : XR=XRC : YR=YRC
  389. '
  390. '  Enforce viewport constraints.
  391. '
  392. XL=XL+VXL : YL=YL+VYL : XR=XR+VXL : YR=YR+VYL
  393. IF XL<VXL THEN XL=VXL
  394. IF YL<VYL THEN YL=VYL
  395. IF XR>VXR THEN XR=VXR
  396. IF YR>VYR THEN YR=VYR
  397. '
  398. '  Set color to default color if it was input as negative.
  399. '
  400. IF C<0 THEN C=DEFLTC
  401. '
  402. '  If box isn't to be drawn, draw line.
  403. '
  404. IF B$<>"B" AND B$<>"BF" THEN
  405. IF XL<>XR THEN
  406. '
  407. '  Draw nonvertical line.
  408. '
  409. NPIX=CINT(SQR((XR-XL)^2+(YR-YL)^2)+.501)
  410. DX=(XR-XL)/(NPIX-1)
  411. FOR I=1 TO NPIX
  412. X=(I-1)*DX+XL
  413. Y=(YR-YL)*(X-XL)/(XR-XL)+YL
  414. INREGS.AX=3072+CINT(C)
  415. INREGS.BX=CINT(ACPAGE)
  416. INREGS.CX=CINT(X)
  417. INREGS.DX=CINT(Y)
  418. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  419. NEXT I
  420. ELSE
  421. '
  422. '  Draw vertical line.
  423. '
  424. FOR Y=YL TO YR
  425. INREGS.AX=3072+CINT(C)
  426. INREGS.BX=CINT(ACPAGE)
  427. INREGS.CX=CINT(XL)
  428. INREGS.DX=CINT(Y)
  429. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  430. NEXT Y
  431. END IF
  432. '
  433. '  Draw box.
  434. '
  435. ELSE
  436. FOR Y=YL TO YR
  437. INREGS.AX=3072+CINT(C)
  438. INREGS.BX=CINT(ACPAGE)
  439. INREGS.CX=CINT(XL)
  440. INREGS.DX=CINT(Y)
  441. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  442. NEXT Y
  443. FOR X=XL+1 TO XR
  444. INREGS.AX=3072+CINT(C)
  445. INREGS.BX=CINT(ACPAGE)
  446. INREGS.CX=CINT(X)
  447. INREGS.DX=CINT(YR)
  448. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  449. NEXT X
  450. FOR Y=YR-1 TO YL STEP -1
  451. INREGS.AX=3072+CINT(C)
  452. INREGS.BX=CINT(ACPAGE)
  453. INREGS.CX=CINT(XR)
  454. INREGS.DX=CINT(Y)
  455. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  456. NEXT Y
  457. FOR X=XR-1 TO XL+1 STEP -1
  458. INREGS.AX=3072+CINT(C)
  459. INREGS.BX=CINT(ACPAGE)
  460. INREGS.CX=CINT(X)
  461. INREGS.DX=CINT(YL)
  462. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  463. NEXT X
  464. END IF
  465. '
  466. '  Fill box if told to do so.
  467. '
  468. IF B$="BF" THEN
  469. FOR Y=YL+1 TO YR-1
  470. FOR X=XL+1 TO XR-1
  471. INREGS.AX=3072+CINT(C)
  472. INREGS.BX=CINT(ACPAGE)
  473. INREGS.CX=CINT(X)
  474. INREGS.DX=CINT(Y)
  475. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  476. NEXT X
  477. NEXT Y
  478. END IF
  479. END SUB
  480. '
  481. '  Subroutine BCIRCLE emulates QB's CIRCLE statement.  The center is at
  482. ' (XCNT,YCNT), the radius is RAD, the color is CL, the starting angle is
  483. ' ST (radians), the ending angle is EN radians, and ASP is the aspect.
  484. ' (As always, all parameters must be specified.)  If EN = ST, a circle/
  485. ' ellipse is drawn.
  486. '
  487. SUB BCIRCLE(XCNT,YCNT,RAD,CL,ST,EN,ASP,INREGS AS REGISTERS,OUTREGS AS REGISTERS)
  488. '
  489. '  Use double precision calculations, set drawing page, and use default
  490. ' color if input color is negative.
  491. '
  492. DIM PI AS DOUBLE,A AS DOUBLE,DA AS DOUBLE,X AS DOUBLE,Y AS DOUBLE,XC AS DOUBLE
  493. DIM YC AS DOUBLE,R AS DOUBLE,ASPECT AS DOUBLE,SA AS DOUBLE,EA AS DOUBLE
  494. R=CDBL(RAD) : ASPECT=CDBL(ASP) : YC=CDBL(YCNT) : XC=CDBL(XCNT) : EA=CDBL(EN)
  495. SA=CDBL(ST) : C=CL
  496. IF ASPECT<0 THEN ASPECT=1#
  497. IF C<0 THEN C=DEFLTC
  498. '
  499. '  Define PI and test for/define circle condition.
  500. '
  501. PI=4#*ATN(1#)
  502. IF EA=SA THEN EA=SA+2#*PI
  503. DA=(EA-SA)/2999#
  504. '
  505. '  Draw arc/circle.
  506. '
  507. FOR I=1 TO 3000
  508. A=DA*CDBL(I-1)+SA
  509. X=XC+R*COS(A) : Y=YC-R*SIN(A)
  510. IF ASPECT>1 THEN X=XC+R*COS(A)/ASPECT
  511. IF ASPECT<1 THEN Y=YC-R*ASPECT*SIN(A)
  512. '
  513. '  Enforce viewport constraints.
  514. '
  515. X=X+CDBL(VXL) : Y=Y+CDBL(VYL)
  516. IF X<VXL THEN X=VXL
  517. IF Y<VYL THEN Y=VYL
  518. IF X>VXR THEN X=VXR
  519. IF Y>VYR THEN Y=VYR
  520. INREGS.AX=3072+CINT(C)
  521. INREGS.BX=CINT(ACPAGE)
  522. INREGS.CX=CINT(X)
  523. INREGS.DX=CINT(Y)
  524. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  525. NEXT I
  526. END SUB
  527. '
  528. '  This is the analog of QB's CLS command.  BCLS clears the screen by
  529. ' putting it in the same video mode that it's already in.  CLSMODE = 0
  530. ' yields an effect equivalent to QB's CLS 0 and CLSMODE = 1 is like CLS 1.
  531. ' (The CLS 1 emulation does not involve the above mentioned mode change
  532. ' operation.  It uses the somewhat slower method of drawing a filled box
  533. ' with color 0.)
  534. '
  535. '
  536. SUB BCLS(CLSMODE,INREGS AS REGISTERS,OUTREGS AS REGISTERS)
  537. '
  538. '  Look for CLS 0/1 condition.  (If no viewport was defined, CLSMODE = 1
  539. ' will be treated as CLS 0.)
  540. '
  541. IF CLSMODE<>1 OR VCOL<0 THEN
  542. '
  543. '  How video mode is detected and changed depends on whether or not VESA
  544. ' bios is present.
  545. '
  546. IF VESSUP=1 THEN GOTO NOVESA
  547. INREGS.AX=&H4F03
  548. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  549. INREGS.AX=&H4F02
  550. INREGS.BX=OUTREGS.BX
  551. GOTO SETMODE
  552. NOVESA:
  553. INREGS.AX=&HF00
  554. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  555. INREGS.AX=OUTREGS.AX AND &HFF
  556. SETMODE:
  557. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  558. '
  559. '  Reset viewport defaults.  (Turn off viewport in case it was defined.)
  560. '
  561. VCOL=-1 : VXL=0 : VYL=0 : VXR=HMAX : VYR=VMAX
  562. ELSE
  563. CALL BVIEW(VXL,VYL,VXR,VYR,VCOL,VBORD,INREGS,OUTREGS)
  564. END IF
  565. END SUB
  566. '
  567. '  This subroutine sets the default color to CL.  (In spite of the "B"
  568. ' leading the subroutine name, there is no bios call involved here.
  569. ' Hence, INREGS and OUTREGS need and must not be passed to this routine.)
  570. ' Unlike BSCREEN, BCOLOR will allow setting the default color to 0.
  571. '
  572. SUB BCOLOR(CL)
  573. C=CL
  574. IF C<0 THEN C=7
  575. DEFLTC=C
  576. END SUB
  577. '
  578. '  BLOCATE emulates QB's LOCATE statement.  R is the row and C is the
  579. ' column.
  580. '
  581. SUB BLOCATE(R,C,INREGS AS REGISTERS,OUTREGS AS REGISTERS)
  582. INREGS.AX=&H200
  583. '
  584. '  Get page number to print to.
  585. '
  586. INREGS.BX=CINT(ACPAGE)
  587. '
  588. '  Bios row and column numbers are zero-based.
  589. '
  590. INREGS.DX=256*CINT(R-1)+CINT(C-1)
  591. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  592. END SUB
  593. '
  594. '  BPRINT is the bios emulator for QB's PRINT statement.  It prints the
  595. ' input character string STRNG$ at the current cursor position.  It does
  596. ' not give a perfect emulation.  Semicolons and commas within STRNG$ are
  597. ' printed like any other character.  A semicolon at the end of STRNG$,
  598. ' however, suspends CR/LF printing just as with PRINT.  Hence, consecutive
  599. ' BPRINT CALLs can be made to achieve the same affect as with PRINT with
  600. ' embedded ";" characters.  Similarly, a comma at the end of STRNG$
  601. ' suppresses CR/LF printing and positions the cursor for the next BPRINT
  602. ' operation on the same line but at column (column after last character
  603. ' printed + 14) MOD 14, i.e., it attempts to emulate what an embedded
  604. ' comma in a PRINT statement would do.  STRNG$ can be a maximum of 126
  605. ' characters.  (It may be noted that QB functions such as STR$ and HEX$
  606. ' can be concatenated with other text to create most any string involving
  607. ' whatever numeric output you want.)
  608. '
  609. SUB BPRINT(STRNG$,INREGS AS REGISTERS,OUTREGS AS REGISTERS)
  610. DIM A(1 TO 32) AS LONG,ROW AS INTEGER,COL AS INTEGER,BYTE AS INTEGER
  611. DIM L AS INTEGER
  612. '
  613. '  Make various initializations.  (For one, STRNG$ is aliased with S$.)
  614. '
  615. SM=VARSEG(A(1)) : OS=VARPTR(A(1)) : INREGS.BP=CINT(OS) : S$=STRNG$ : L=LEN(S$)
  616. IF L=0 THEN S$=" " : L=1
  617. IF L>126 THEN L=126
  618. '
  619. '  S$ will be stored in array A.  Point memory pointer there and
  620. ' transfer characters.
  621. '
  622. DEF SEG=SM
  623. IF L>1 THEN
  624. FOR I=1 TO L-1
  625. BYTE=ASC(MID$(S$,I,1))
  626. POKE OS,BYTE
  627. OS=OS+1
  628. NEXT I
  629. END IF
  630. '
  631. '  Look for ";" or "," at end of S$.  Terminate stored string with CR/LF
  632. ' if these characters are absent.  Adjust number of characters (L) to be
  633. ' printed accordingly.
  634. '
  635. BYTE=ASC(MID$(S$,L,1))
  636. IF BYTE<>59 AND BYTE<>44 THEN
  637. POKE OS,BYTE
  638. OS=OS+1
  639. POKE OS,13
  640. OS=OS+1
  641. POKE OS,10
  642. L=L+2
  643. ELSE
  644. L=L-1
  645. END IF
  646. DEF SEG
  647. '
  648. '  Get page to print to and current cursor location and then print string
  649. ' there with default color.
  650. '
  651. INREGS.AX=&H300
  652. INREGS.BX=CINT(ACPAGE)
  653. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  654. INREGS.AX=&H1301
  655. INREGS.BX=DEFLTC
  656. INREGS.CX=L
  657. INREGS.DX=OUTREGS.DX
  658. INREGS.ES=CINT(SM)
  659. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  660. IF BYTE=44 THEN
  661. INREGS.AX=&H300
  662. INREGS.BX=CINT(ACPAGE)
  663. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  664. ROW=(OUTREGS.DX AND &HFF00)/256
  665. COL=OUTREGS.DX AND &HFF
  666. COL=COL+14
  667. COL=14*INT(CSNG(COL+1)/14+.001)-1
  668. INREGS.AX=&H200
  669. INREGS.BX=CINT(ACPAGE)
  670. INREGS.DX=256*ROW+COL
  671. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  672. END IF
  673. END SUB
  674. '
  675. '  This function is the analog of QB's POINT function.  Unlike the other
  676. ' page-oriented routines, it reads data from the page being displayed.
  677. ' (QB's "POINT(number)" function is not emulated here.)  (The pixel
  678. ' color attribute returned is a 2-byte integer.)
  679. '
  680. FUNCTION BPOINT%(XCOORD,YCOORD,INREGS AS REGISTERS,OUTREGS AS REGISTERS)
  681. '
  682. '  Get displayed page.
  683. '
  684. INREGS.AX=&HF00
  685. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  686. '
  687. '  Translate (XCOORD,YCOORD) to screen coordinates and enforce viewport
  688. ' constraints.
  689. '
  690. X=XCOORD+VXL : Y=YCOORD+VYL
  691. IF X<VXL THEN X=VXL
  692. IF Y<VYL THEN Y=VYL
  693. IF X>VXR THEN X=VXR
  694. IF Y>VYR THEN Y=VYR
  695. '
  696. '  Get color attribute of pixel at (X,Y).
  697. '
  698. INREGS.AX=&HD00
  699. INREGS.BX=OUTREGS.BX
  700. INREGS.CX=CINT(X)
  701. INREGS.DX=CINT(Y)
  702. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  703. BPOINT=OUTREGS.AX AND &HFF
  704. END FUNCTION
  705. '
  706. '  This is the analog of QB's graphics VIEW statement.  Input positive
  707. ' numbers for CL and BORDER to fill the viewport with color CL or draw
  708. ' a box around it with color BORDER.  (Use BORDER <= 0 to avoid drawing a
  709. ' a border.  Fill color is set to 0 if CL < 0.)
  710. '
  711. SUB BVIEW(XL,YL,XR,YR,CL,BORDER,INREGS AS REGISTERS,OUTREGS AS REGISTERS)
  712. VXL=CINT(XL) : VYL=CINT(YL) : VXR=CINT(XR) : VYR=CINT(YR)
  713. '
  714. '  Disallow plotting off-screen and make other reasonable enforcements.
  715. '
  716. IF VXL<0 THEN VXL=0
  717. IF VYL<0 THEN VYL=0
  718. IF VXR>HMAX THEN VXR=HMAX
  719. IF VYR>VMAX THEN VYR=VMAX
  720. IF VXL>HMAX THEN VXL=0
  721. IF VYL>VMAX THEN VYL=0
  722. IF VXR<0 THEN VXR=HMAX
  723. IF VYR<0 THEN VYR=VMAX
  724. IF VXR<=VXL THEN VXL=0 : VXR=HMAX
  725. IF VYR<=VYL THEN VYL=0 : VYR=VMAX
  726. '
  727. '  Process CL and BORDER arguments.  (Save them in global variables for
  728. ' BCLS subroutine.)
  729. '
  730. VCOL=CL : IF VCOL<0 THEN VCOL=0
  731. VBORD=BORDER
  732. '
  733. '  Clear viewport (fill with VCOL) and then draw border if appropriate.
  734. ' (Send BLINE viewport coordinates--it will convert them back to screen
  735. ' coordinates.)
  736. '
  737. CALL BLINE(0!,0!,VXR-VXL,VYR-VYL,VCOL,"BF",INREGS,OUTREGS)
  738. IF VBORD>0 THEN CALL BLINE(0!,0!,VXR-VXL,VYR-VYL,VBORD,"B",INREGS,OUTREGS)
  739. END SUB
  740. '
  741. '  This subroutine emulates QB's PAINT statement.
  742. '
  743. SUB BPAINT(XP,YP,CL,BORDER,INREGS AS REGISTERS,OUTREGS AS REGISTERS)
  744. DIM CPIXEL AS INTEGER,I AS INTEGER,J AS INTEGER
  745. C=CL : IF C<0 THEN C=DEFLTC
  746. '
  747. '  Translate (XP,YP) to screen coordinates.
  748. '
  749. X=XP+VXL : Y=YP+VYL
  750. '
  751. '  If (X,Y) isn't within viewport, don't do anything.
  752. '
  753. IF X<VXL OR Y<VYL OR X>VXR OR Y>VYR THEN GOTO LEAVE
  754. '
  755. '  Set background color.  (Painting will only occur if current pixel is
  756. ' set to this color, which will be zero unless a filled viewport is
  757. ' active.)
  758. '
  759. CBACK=VCOL : IF CBACK<0 THEN CBACK=0
  760. '
  761. '  If (X,Y) is on border of area to be painted, no painting occurs.
  762. '
  763. INREGS.AX=&HD00
  764. INREGS.BX=CINT(ACPAGE)
  765. INREGS.CX=CINT(X)
  766. INREGS.DX=CINT(Y)
  767. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  768. CPIXEL=OUTREGS.AX AND &HFF
  769. IF CPIXEL<>CBACK THEN GOTO LEAVE
  770. '
  771. '  Begin painting.  Do points above input (X,Y) first.
  772. '
  773. IF CINT(Y)>=VYL THEN
  774. FOR J=CINT(Y) TO VYL  STEP -1
  775. '
  776. '  Do points to right of input (X,Y) first.
  777. '
  778. IF CINT(X)<=VXR THEN
  779. FOR I=CINT(X) TO VXR
  780. '
  781. '  Get pixel color at point (I,J).
  782. '
  783. INREGS.AX=&HD00
  784. INREGS.BX=CINT(ACPAGE)
  785. INREGS.CX=I
  786. INREGS.DX=J
  787. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  788. CPIXEL=OUTREGS.AX AND &HFF
  789. '
  790. '  Paint interior/exterior pixel with paint color, border pixel with
  791. ' border color (for non-negative BORDER input), or move to next part of
  792. ' figure.
  793. '
  794. IF CPIXEL=CBACK THEN CALL BPSET(CSNG(I)-VXL,CSNG(J)-VYL,C,INREGS,OUTREGS)
  795. IF CPIXEL<>CBACK THEN
  796. IF BORDER>=0 THEN CALL BPSET(CSNG(I)-VXL,CSNG(J)-VYL,BORDER,INREGS,OUTREGS)
  797. EXIT FOR
  798. END IF
  799. NEXT I
  800. END IF
  801. '
  802. '  Do points to left of input (X,Y).
  803. '
  804. IF CINT(X)-1>=VXL THEN
  805. FOR I=CINT(X)-1 TO VXL STEP -1
  806. INREGS.AX=&HD00
  807. INREGS.BX=CINT(ACPAGE)
  808. INREGS.CX=I
  809. INREGS.DX=J
  810. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  811. CPIXEL=OUTREGS.AX AND &HFF
  812. IF CPIXEL=CBACK THEN CALL BPSET(CSNG(I)-VXL,CSNG(J)-VYL,C,INREGS,OUTREGS)
  813. IF CPIXEL<>CBACK THEN
  814. IF BORDER>=0 THEN CALL BPSET(CSNG(I)-VXL,CSNG(J)-VYL,BORDER,INREGS,OUTREGS)
  815. EXIT FOR
  816. END IF
  817. NEXT I
  818. IF I=CINT(X)-1 THEN EXIT FOR
  819. END IF
  820. NEXT J
  821. END IF
  822. '
  823. '  Now do points below input (X,Y).
  824. '
  825. IF CINT(Y)+1<=VYR THEN
  826. FOR J=CINT(Y)+1 TO VYR
  827. IF CINT(X)<=VXR THEN
  828. FOR I=CINT(X) TO VXR
  829. INREGS.AX=&HD00
  830. INREGS.BX=CINT(ACPAGE)
  831. INREGS.CX=I
  832. INREGS.DX=J
  833. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  834. CPIXEL=OUTREGS.AX AND &HFF
  835. IF CPIXEL=CBACK THEN CALL BPSET(CSNG(I)-VXL,CSNG(J)-VYL,C,INREGS,OUTREGS)
  836. IF CPIXEL<>CBACK THEN
  837. IF BORDER>=0 THEN CALL BPSET(CSNG(I)-VXL,CSNG(J)-VYL,BORDER,INREGS,OUTREGS)
  838. EXIT FOR
  839. END IF
  840. NEXT I
  841. END IF
  842. IF CINT(X)-1>=VXL THEN
  843. FOR I=CINT(X)-1 TO VXL STEP -1
  844. INREGS.AX=&HD00
  845. INREGS.BX=CINT(ACPAGE)
  846. INREGS.CX=I
  847. INREGS.DX=J
  848. CALL INTERRUPTX(&H10,INREGS,OUTREGS)
  849. CPIXEL=OUTREGS.AX AND &HFF
  850. IF CPIXEL=CBACK THEN CALL BPSET(CSNG(I)-VXL,CSNG(J)-VYL,C,INREGS,OUTREGS)
  851. IF CPIXEL<>CBACK THEN
  852. IF BORDER>=0 THEN CALL BPSET(CSNG(I)-VXL,CSNG(J)-VYL,BORDER,INREGS,OUTREGS)
  853. EXIT FOR
  854. END IF
  855. NEXT I
  856. IF I=CINT(X)-1 THEN EXIT FOR
  857. END IF
  858. NEXT J
  859. END IF
  860. LEAVE:
  861. END SUB
  862.